perm filename TICTA1.LSP[206,JMC] blob sn#073065 filedate 1973-11-16 generic text, type T, neo UTF8

(DEFPROP TICTACFNS
 (TRY2 NEWGAME TER IMVAL SUCCESSORS REVERT UPDATE PTS LINES SORT
SORTA SORTB SORTC WIN ANSWER DOUBLETH THREAT)
VALUE)

(DEFPROP NEWGAME
 (LAMBDA NIL
  (PROG	NIL
	(SETQ P1 NIL)
	(SETQ XS NIL)
	(SETQ OS NIL)
	(SETQ BS (QUOTE (1 2 3 4 5 6 7 10 11)))
	(SETQ W NIL)
	(SETQ LEVEL 0)
	(SETQ COUNT 0)
	(RETURN (QUOTE (NEW GAME)))))
EXPR)

(DEFPROP TER
 (LAMBDA(P ALPHA BETA)
  (AND (NOT (NULL P))
	 (OR (EQUAL LEVEL 11)
	     (LESSP (DIFFERENCE 11 LEVEL) (CAR ALPHA))
	     (GREATERP (PLUS -11 LEVEL) (CAR BETA))
	     (ORLIS (FUNCTION (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (COND (W XS) (T OS)))))
		    (CAR (NTH LINES (CAR P))))))
)
EXPR)

(DEFPROP IMVAL
 (LAMBDA(P ALPHA BETA)
  (COND	((ORLIS	(FUNCTION (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (COND (W XS) (T OS)))))
		(CAR (NTH LINES (CAR P))))
	 (COND (W (DIFFERENCE 12 LEVEL)) (T (PLUS -12 LEVEL))))
	(T 0)))
EXPR)

(DEFPROP SUCCESSORS
 (LAMBDA (P ALPHA BETA) (SORT (MAPCAR (FUNCTION (LAMBDA (X) (CONS X P))) BS)))
EXPR)

(DEFPROP REVERT
 (LAMBDA NIL
  (PROG	NIL
	(SETQ LEVEL (SUB1 LEVEL))
	(SETQ BS (CONS (CAR (COND (W XS) (T OS))) BS))
	(COND (W (SETQ XS (CDR XS))) (T (SETQ OS (CDR OS))))
	(SETQ W (NOT W))
	(SETQ P1 (CDR P1))
	(RETURN (LIST (QUOTE XS) XS (QUOTE OS) OS (QUOTE BS) BS (QUOTE W) W (QUOTE P1) P1))))
EXPR)

(DEFPROP UPDATE
 (LAMBDA(M)
  (PROG	NIL
	(SETQ LEVEL (ADD1 LEVEL))
	(COND (W (SETQ OS (CONS M OS))) (T (SETQ XS (CONS M XS))))
	(SETQ BS (DELETE M BS))
	(SETQ P1 (CONS M P1))
	(SETQ W (NOT W))
	(SETQ COUNT (ADD1 COUNT))
	(RETURN (LIST (QUOTE XS) XS (QUOTE OS) OS (QUOTE BS) BS (QUOTE W) W (QUOTE P1) P1))))
EXPR)

(DEFPROP PTS
 (NIL (1 2 3) (4 5 6) (7 10 11) (1 4 7) (2 5 10) (3 6 11) (1 5 11) (3 5 7))
VALUE)

(DEFPROP LINES
 (NIL (1 4 7) (1 5) (1 6 10) (2 4) (2 5 7 10) (2 6) (3 4 10) (3 5) (3 6 7))
VALUE)

(DE SORT (U) (SORTA U NIL NIL))

(DE SORTA (U TH ORD) (COND ((NULL U) (APPEND TH ORD))
	((WIN (CAR U)) (LIST (CAR U)))
	((ANSWER (CAR U)) (SORTB (CDR U) (CAR U)))
	((DOUBLETH (CAR U)) (SORTC (CDR U) (CAR U)))
	((THREAT (CAR U)) (SORTA (CDR U) (CONS (CAR U) TH) ORD))
	(T (SORTA (CDR U) TH (CONS (CAR U) ORD)))))

(DE SORTB (U M) (COND ((NULL U) (LIST M))
	((WIN (CAR U)) (LIST (CAR U)))
	(T (SORTB (CDR U) M))))

(DE SORTC (U M) (COND ((NULL U) (LIST M))
	((WIN (CAR U)) (LIST (CAR U)))
	((ANSWER (CAR U)) (SORTB (CDR U) (CAR U)))
	(T (SORTC (CDR U) M))))

(DEFPROP WIN
 (LAMBDA(P)
  (ORLIS (FUNCTION (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (CONS (CAR P) (COND (W OS) (T XS))))))
	 (CAR (NTH LINES (CAR P)))))
EXPR)

(DEFPROP ANSWER
 (LAMBDA(P)
  (ORLIS (FUNCTION (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (CONS (CAR P) (COND (W XS) (T OS))))))
	 (CAR (NTH LINES (CAR P)))))
EXPR)

(DEFPROP THREAT
 (LAMBDA(P)
  (ORLIS (FUNCTION
	  (LAMBDA(SQ)
	   (ORLIS (FUNCTION
		   (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (CONS SQ (CONS (CAR P) (COND (W OS) (T XS)))))))
		  (CAR (NTH LINES SQ)))))
	 (DELETE (CAR P) BS)))
EXPR)

(DE DOUBLETH (P) 
  (TWOLIS (FUNCTION
	  (LAMBDA(SQ)
	   (ORLIS (FUNCTION
		   (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (CONS SQ (CONS (CAR P) (COND (W OS) (T XS)))))))
		  (CAR (NTH LINES SQ)))))
	 (DELETE (CAR P) BS)))

(DE TWOLIS (PRED U) (AND (NOT (NULL U)) (OR (AND (PRED (CAR U)) (ORLIS PRED
(CDR U))) (TWOLIS PRED (CDR U)))))